home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GS_WIND.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  6KB  |  246 lines
  1. UNIT GS_Wind;
  2.  
  3. INTERFACE
  4.  
  5. USES
  6.    Crt,
  7.    Dos,
  8.    GS_Scrn;
  9.  
  10. Type
  11.    GS_Wind_Str80  =  string[80];
  12.  
  13.    GS_Wind_Pntr   =  ^GS_Wind_Objt;
  14.  
  15.    GS_Wind_Objt   = Object
  16.                        x1,
  17.                        y1,
  18.                        x2,
  19.                        y2      :  integer;  {Window size}
  20.                        fg,                  {Foreground color}
  21.                        bg,                  {Background color}
  22.                        tx,                  {Text color}
  23.                        bgh,                 {Inverted background color}
  24.                        txh     :  byte;     {Inverted text color}
  25.                        CurX,                {Last X position when new window}
  26.                        CurY    :  integer;  {Last Y position when new window}
  27.                        dobox   :  boolean;  {Flag to draw a box option}
  28.                        boxname :  GS_Wind_Str80;
  29.                                             {Name for a box when drawn}
  30.                        copywin :  boolean;  {Flag to save old screen area}
  31.                                             {and restore when released}
  32.                        winpntr :  pointer;  {Storage for old screen area}
  33.                        lastwin :  GS_Wind_Pntr;
  34.                                             {Pointer to last window object}
  35.                        procedure MakBox;
  36.                        procedure InitWin (x1w,y1w,x2w,y2w : integer;
  37.                                           txw,bgw,fgw,txx,bgx : integer;
  38.                                           dbox : boolean;
  39.                                           bname : GS_Wind_Str80;
  40.                                           cpywin : boolean);
  41.                        procedure SetWin;
  42.                        procedure ClrWin;
  43.                        procedure RelWin;
  44.                        procedure AlwWin;
  45.                     end;
  46.  
  47. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  48. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  49. Procedure GS_Wind_SetNmMode;
  50. Procedure GS_Wind_SetFgMode;
  51. Procedure GS_Wind_SetIvMode;
  52.  
  53. implementation
  54.  
  55.  
  56. Var
  57.    win     :  GS_Wind_Objt;
  58.    Win_Ptr :  ^GS_Wind_Objt;
  59.    ok_win  :  boolean;
  60.    i       :  integer;
  61.  
  62. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  63. begin
  64.    with Win_Ptr^ do
  65.    begin
  66.       txw := tx;
  67.       bgw := bg;
  68.       fgw := fg;
  69.       txx := txh;
  70.       bgx := bgh;
  71.    end;
  72. end;
  73.  
  74. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  75. begin
  76.    with Win_Ptr^ do
  77.    begin
  78.       tx  := txw;
  79.       bg  := bgw;
  80.       fg  := fgw;
  81.       txh := txx;
  82.       bgh := bgx;
  83.    end;
  84. end;
  85.  
  86. Procedure GS_Wind_SetNmMode;
  87. begin
  88.    with Win_Ptr^ do
  89.    begin
  90.       TextColor(tx);
  91.       TextBackground(bg);
  92.    end;
  93. end;
  94.  
  95. Procedure GS_Wind_SetFgMode;
  96. begin
  97.    with Win_Ptr^ do
  98.    begin
  99.       TextColor(fg);
  100.       TextBackground(bg);
  101.    end;
  102. end;
  103.  
  104. Procedure GS_Wind_SetIvMode;
  105. begin
  106.    with Win_Ptr^ do
  107.    begin
  108.       TextColor(txh);
  109.       TextBackground(bgh);
  110.    end;
  111. end;
  112.  
  113.  
  114. procedure GS_Wind_Objt.MakBox;
  115. var
  116.    wsmin,
  117.    wsmax     : word;
  118.    wscx,
  119.    wscy,
  120.    wsattr    : byte;
  121.    x, q      : integer;
  122.    s         : string;
  123.  
  124. begin
  125.    wsmin := WindMin;
  126.    wsmax := WindMax;
  127.    wsattr := TextAttr;
  128.    wscx := wherex;
  129.    wscy := wherey;
  130.    TextColor(fg);
  131.    window (1,1,80,25);
  132.    FillChar(s[1],80,#205);
  133.    x := succ(x2-x1);
  134.    s[0] := chr(x);
  135.    s[1] := #213;
  136.    if length(boxname) > 0 then
  137.    begin
  138.       if length(boxname) > x-2 then boxname[0] := chr(x-2);
  139.       x := (x-length(boxname)) div 2;
  140.       move(boxname[1],s[x+1],length(boxname));
  141.    end;
  142.    s[length(s)] := #184;
  143.    gotoxy(x1,y1);
  144.    write(s);
  145.    for q := y1+1 to y2-1 do
  146.    begin
  147.       gotoxy(x1,q);
  148.       write(#179);
  149.       gotoxy(x2,q);
  150.       write(#179);
  151.    end;
  152.    gotoxy(x1,y2);
  153.    FillChar(s[1],80,#205);
  154.    s[1] := #212;
  155.    s[0] := chr(pred(length(s)));
  156.    write(s);
  157.    GS_Scrn_Put_Char(x2,y2,#190);
  158.    WindMin := wsmin;
  159.    WindMax := wsmax;
  160.    TextAttr := wsattr;
  161.    gotoxy(wscx,wscy);
  162. end;
  163.  
  164. procedure GS_Wind_Objt.SetWin;
  165. begin
  166.    lastwin := win_ptr;
  167.    win_Ptr := @Self;
  168.    lastwin^.CurX := whereX;
  169.    lastwin^.CurY := wherey;
  170.    if copywin then
  171.       GS_Scrn_Get_Win(x1,y1,x2,y2,winpntr^);
  172.    TextColor(fg);
  173.    TextBackground(bg);
  174.    if dobox then
  175.    begin
  176.       MakBox;
  177.       window(x1+1, y1+1, x2-1, y2-1)
  178.    end else
  179.       window(x1, y1, x2, y2);
  180.    TextColor(tx);
  181.    ClrScr;
  182. end;
  183.  
  184. procedure GS_Wind_Objt.AlwWin;
  185. begin
  186.    if dobox then
  187.       window(x1+1, y1+1, x2-1, y2-1)
  188.    else
  189.       window(x1, y1, x2, y2);
  190. end;
  191.  
  192.  
  193.  
  194. procedure GS_Wind_Objt.ClrWin;
  195. begin
  196.    win.SetWin;
  197. end;
  198.  
  199. procedure GS_Wind_Objt.RelWin;
  200. begin
  201.    if copywin then
  202.       GS_Scrn_Put_Win(x1,y1,x2,y2,winpntr^);
  203.    win_Ptr := lastwin;
  204.    TextColor(lastwin^.tx);
  205.    TextBackground(lastwin^.bg);
  206.    if lastwin^.dobox then
  207.    begin
  208.       window(lastwin^.x1+1, lastwin^.y1+1, lastwin^.x2-1, lastwin^.y2-1)
  209.    end else
  210.       window(lastwin^.x1, lastwin^.y1, lastwin^.x2, lastwin^.y2);
  211.    gotoXY(lastwin^.CurX,lastwin^.CurY);
  212. end;
  213.  
  214.  
  215. procedure GS_Wind_Objt.InitWin(x1w,y1w,x2w,y2w : integer;
  216.                                txw,bgw,fgw,txx,bgx : integer;
  217.                                dbox : boolean;
  218.                                bname : GS_Wind_Str80;
  219.                                cpywin : boolean);
  220. var
  221.    i,x,q   :  integer;
  222. begin
  223.    x1 := x1w;
  224.    y1 := y1w;
  225.    x2 := x2w;
  226.    y2 := y2w;
  227.    fg := fgw;
  228.    bg := bgw;
  229.    tx := txw;
  230.    txh := txx;
  231.    bgh := bgx;
  232.    dobox := dbox;
  233.    boxname := bname;
  234.    copywin := cpywin;
  235.    if cpywin then
  236.       GetMem(winpntr,(((x2-x1)+1) * ((y2-y1)+1)) * 2)
  237.    else winpntr := nil;
  238. end;
  239.  
  240. begin
  241.    win.InitWin (1,1,80,25,7,0,7,0,7,FALSE,'',FALSE);
  242.    win_ptr := @win;
  243.    win.SetWin;
  244.    win.lastwin := win_Ptr;
  245. end.
  246.